perm filename M11X.OLD[M11,LCS] blob
sn#406226 filedate 1978-12-28 generic text, type T, neo UTF8
00100 CPASS3 PASS 3 MAIN PROGRAM
00200 C *** MUSIC V ***
00300 INTEGER PEAK,CONV
00400 CXX DOUBLE PRECISION JFLNM,JTRNS,JBLA
00500 DIMENSION T(50),TI(50),ITI(50)
00600 CSS COMMON I(513) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,RPEAK,NBUF
00700 COMMON I(513) /P/P(50) /FINOUT/PEAK,RPEAK,NBUF
00800 1 /IRAN/IRAN /CONV/CONV,INIOUT,JFLNM
00900 1 /LFUNC/LFUNC,XNFUN /IFIRST/IFIRST,IDT
00950 1 /GENS/GENS(3072) /LOCG/LOCG(6)
00960 DO 10 N1=1,NGENS
00965 10 LOCG(N1)=(N1-1)*LFUNC+1
00975 C ABOVE SETS UP 6 POSSIBLE FUNCS. THESE MAY BE INCREASED.
01100 C TO INCREASE NUM. OF GENS AVAILABLE ENLARGE 'GENS' BY 512 PER GEN AND
01200 C PUT PROPER NUMBER INTO 'NGENS' DATA AND 'LOCG' ARRAY SIZE.
01300
01400 C NOPCD=NUM.OF OP CODES, ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
01500 DATA NOPCD/14/, ISRT/10000/, LFUNC/512/, CONV/-1/,XNFUN/511.0/
01600 1 , NPAR/35/, NINS/27/, LBLK/512/, NGENS/6/
01700 C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., LBLK=LENGTH OF OUTPUT BLOCKS
01800
01900 COMMON /INS/INS(400),IDEF(100) /NT/RNT(1000) /ROUT/ROUT(3072)
02000 C INS=INSTRUMENT DEFINITIONS, IDEF=LOCATION TABLE, ROUT=OUTPUT BLOCK (B1→B6)(6*512)
02100 EQUIVALENCE (I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3)),(P4,P(4))
02200 1, (I5,I(5)),(I6,I(6)),(I4,I(4)),(P2,P(2))
02300 DATA JTRNS/'TRNS '/,JBLA/' '/
02400 DATA IIIRD/976545367/
02500 C INITIALIZATION OF PIECE
02600 C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
02700 CXX IRAN=32767
02800 CXX IRAN=I(7)+1
02900 IRAN=IIIRD
03000 NBUF=512
03100 CC******* NREAD = 3
03200 CC******* NWRITE = 2
03300 NREAD=21
03400 C PDP DSK1=DEV.21
03500 NWRITE=1
03600 C PDP DSK=DEV.1
03700 CXX REWIND NREAD
03800 CXX REWIND NWRITE
03900 CZZ44 TYPE 401
04000 CZZ ACCEPT 501,JFLNM,CONV
04100 C TYPE <CR> FOR DEFAULT NAME(FOR21.DAT), ADD A NUM. TO WRITE SMPLS TO BE PLAYED.
04200 CC IF(JFLNM.EQ.JBLA)JFLNM=JTRNS
04300 CXX CALL OPEN(21,JFLNM,0,'RDO',,,'UNF')
04400 CZZ CALL IFILE(21,JFLNM)
04500 C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
04600 401 FORMAT(' TYPE FILE NAME'/)
04700 501 FORMAT(A5,5I)
04800 1000 INIOUT=-1
04900 C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
05000 IFIRST=-1
05100 IDT=1
05200 C ABOVE 2 ARE IN TRANS. ROUTINES.
05300 PEAK=0
05400 CSS IPEAK=0
05500 RPEAK=0
05600 C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
05700 I2=1
05800 MS1=1
05900 MS3=MS1+(NPAR*NINS)-1
06000 MS2=NPAR
06100 IF(I4.EQ.0)I4=ISRT
06200 MOUT=1
06300
06400 C INITIALIZATION OF SECTION
06500 5 T(1)=0.0
06600 DO 220 N1=MS1,MS3,MS2
06700 C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
06800 220 RNT(N1)=-1
06900 DO 221 N1=1,NINS
07000 221 TI(N1)=90909.
07100
07200 C MAIN CARD READING LOOP
07300 204 CALL DATA (NREAD)
07400 IF(P2-T(1))200,200,244
07500 200 IOP=P(1)
07600 IF(IOP)201,201,202
07700 201 CALL ERROR(1)
07800 GO TO 204
07900
08000 202 IF(NOPCD-IOP)201,203,203
08100 203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
08200 11 IVAR=P3
08300 IVARE=IVAR+I(1)-4
08400 DO 297 N1=IVAR,IVARE
08500 IVARP=N1-IVAR+4
08600 297 I(N1)=P(IVARP)
08700 C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
08800 IF(N1.EQ.8)NBUF=512+512*I(N1)
08900 C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
09000 GO TO 204
09100 3 IGEN=P3
09200 CC IF(P4.GT.NGENS)CALL ERROR(4)
09300 IF(P4.GT.NGENS)PAUSE ' FUNC. NUM. OUT RANGE'
09400 C ERROR 4=FUNC NUMB. OUT OF RANGE.
09500 IF(IGEN.NE.1)GO TO 282
09600 CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
09700 281 CALLGEN1
09800 GO TO 204
09900 282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
10000 CALLGEN2
10100 GO TO 204
10200
10300 4 IVAR=P3
10400 IVARE=IVAR+I(1)-4
10500 DO 296N1=IVAR,IVARE
10600 IVARP=N1-IVAR+4
10700 296 I(N1+100)=P(IVARP)
10800 GO TO 204
10900 6 CALL FROUT3(IDSK)
11000 CCCC STOP
11100 GO TO 1000
11200
11300 C ENTER NOTE TO BE PLAYED
11400 1 DO 230N1=MS1,MS3,MS2
11500 230 IF(RNT(N1).EQ.-1)GO TO 231
11600 CALL ERROR(2)
11700 C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
11800 TYPE 1230,NINS
11900 GO TO 204
12000 1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
12100 231 M1=N1
12200 M2=N1+I(1)-1
12300 M3=M2+1
12400 M4=N1+NPAR-1
12500 DO 232N1=M1,M2
12600 M5=N1-M1+1
12700 232 RNT(N1)=P(M5)
12800 RNT(M1 )=P3
12900 DO 233N1=M3,M4
13000 233 RNT(N1)=0
13100 DO 235N1=1,NINS
13200 IF(TI(N1)-90909.)235,234,235
13300 234 TI(N1)=P2+P4
13400 ITI(N1)=M1
13500 GO TO 204
13600 235 CONTINUE
13700 CALL ERROR(3)
13800 GO TO 204
13900
14000 C DEFINE INSTRUMENT
14100 2 M1=I2
14200 M2=IFIX(P3)
14300 IDEF(M2)=M1
14400 218 CALL DATA (NREAD)
14500 IF(I(1)-2)210,210,211
14600 210 INS(M1)=0
14700 I2=M1+1
14800 GO TO 204
14900 211 INS(M1)=P3
15000 M3=I(1)
15100 INS(M1+1)=M1+M3-1
15200 M1=M1+2
15300 DO 217N1=4,M3
15400 M5=P(N1)
15500 IF(M5)212,213,213
15600 212 IF(M5+100)300,301,301
15700 300 INS(M1)=-1+(M5+101)*LFUNC
15800 GO TO 216
15900 301 INS(M1)=-1+(M5+1)*LBLK
16000 GO TO 216
16100 213 IF(M5- 100 )214,214,215
16200 214 INS(M1)=M5
16300 GO TO 216
16400 215 INS(M1)=M5+26262
16500 C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
16600 C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
16700 216 M1=M1+1
16800 217 CONTINUE
16900 GO TO 218
17000
17100 C PLAY TO ACTION TIME
17200 244 T2=P2
17300 250 TMIN=90909.
17400 IREST=1
17500 DO 241N1=1,NINS
17600 IF(TMIN-TI(N1))241,241,240
17700 240 TMIN=TI(N1)
17800 MNOTE=N1
17900 241 CONTINUE
18000 IF(90909.-TMIN)251,251,243
18100 243 IF(TMIN-T2)245,245,246
18200 245 T3=TMIN
18300 GO TO 260
18400 246 T3=T2
18500 GO TO 260
18600 247 IF(T(1)-T2)249,200,200
18700 249 TI(MNOTE)=90909.
18800 M2=ITI(MNOTE)
18900 RNT(M2)=-1
19000 GO TO 250
19100
19200 C SETUP REST
19300 251 T3=T2
19400 IREST=2
19500 GO TO 260
19600
19700 C PLAY
19800 260 ISAM=(T3-T(1))*FLOAT(I4)+.5
19900 T(1)=T3
20000 IF(ISAM)247,247,266
20100 266 IF(ISAM-LBLK)262,262,263
20200 262 I5=ISAM
20300 ISAM=0
20400 GO TO 264
20500 263 I5=LBLK
20600 ISAM=ISAM-LBLK
20700 264 IF(I(8))290,290,291
20800 290 M3=MOUT+I5-1
20900 MSAMP=I5
21000 GO TO 292
21100 291 M3=MOUT+(2*I5)-1
21200 MSAMP=2*I5
21300 292 DO 267N1=MOUT,M3
21400 267 ROUT(N1)=0
21500 GO TO (268,265),IREST
21600
21700 268 DO 270 NS1=MS1,MS3,MS2
21800 IF(RNT(NS1)+1)271,270,271
21900 C GO THROUGH UNIT GENERATORS IN INSTRUMENT
22000 271 I(3)=NS1
22100 IGEN=RNT(NS1)
22200 IGEN=IDEF(IGEN)
22300 272 I6=IGEN
22400 294 CALL FORSAM
22500 295 IGEN=INS(IGEN+1)
22600 IF(INS(IGEN))270,270,272
22700 270 CONTINUE
22800 265 CALL SAMOUT(IDSK ,MSAMP)
22900 IF(ISAM)247,247,266
23000 END
23100
23200 CDATA3 PASS 3 DATA INPUTING ROUTINE
23300 SUBROUTINE DATA (N)
23400 COMMON I(1)/P/ P(1) /FINOUT/PEAK,RPEAK /IFIRST/IFIRST,IDT
23500 CSS COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK
23600 EQUIVALENCE (K,I),(P2,P(2))
23700 CALL TRANS(IDT)
23800 CZZ READ (N) K,(P(J),J=1,K)
23900 IF(P(1).EQ.1)TYPE 1,P2
24000 IF(PEAK.LE.RPEAK)RETURN
24100 CSS IF(JPEAK.LE.IPEAK)RETURN
24200 TYPE 2,PEAK
24300 CSS TYPE 2,JPEAK
24400 RPEAK=PEAK
24500 CSS IPEAK=JPEAK
24600 C TYPES OUT EACH NEW PEAK AMPL.
24700 RETURN
24800 1 FORMAT('+',F9.2,$)
24900 2 FORMAT('+ AMPL=',F5.0,$)
25000 CSS2 FORMAT('+ AMPL=',I4,$)
25100 END
25200
25300 SUBROUTINE FROUT3(IDSK)
25400 C TERMINATE OUTPUT
25500 COMMON /ROUT/ROUT(1) /FINOUT/PEAK /CONV/CONV
25600 CC 1 /IFIRST/IFIRST,IDT
25700 CC IFIRST=-1
25800 CC IDT=0
25900 C THE ABOVE ARE RESETS TO GET BACK TO 'INPUT?'
26000 DO 1 K=1,512
26100 1 ROUT(K)=0
26200 CALL SAMOUT(IDSK,512)
26300 TYPE 10,PEAK
26400 C NOW CLOSE OFF THE FILE
26500 IF(CONV.NE.0)GO TO 3
26600 END FILE 23
26700 RETURN
26800 C3 CALL FINFIL
26900 3 CALL FINEXT
27000 CC TYPE 2
27100 CALL PLAY
27200 RETURN
27300 2 FORMAT(' TEST.SND WAS WRITTEN ********')
27400 10 FORMAT ('0PEAK AMPLITUDE WAS ',F7.0)
27500 END